perm filename CHTSER.MID[NET,MRC]1 blob sn#573659 filedate 1981-03-24 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE CHTSER
C00004 00003	CORBEG INBUFH OUTBFH GOTINT TTYLIN PTIBUF COREND LSNBLK HOST SMRBLK RMRBLK INPBLK ECHOFF TYSBLK IMPSET LINCON LINCOF GAGOFF NTYSTS TERMID TERSTR
C00006 00004	CHTSER
C00008 00005	FOO1 FOO2 FOO3 FOO4
C00010 00006	LOOP LOOP0 LOOP1 PUPLP0 PUPLP1
C00012 00007	PUPICH PUPIC1 PTILP0 PTILUP PUPSND CLOSED
C00015 ENDMK
CāŠ—;
TITLE CHTSER
SUBTTL Definitions

; Mark Crispin, SU-AI, February '81

; Ethernet TELNET server

; AC definitions

A=1 ? B=2 ? C=3 ? D=4

; System definitions

INTPTO==001000,,		; PTY interrupt
INTCLK==000200,,		; clock interrupts
INTIMS==000020,,		; closed interrupt
INTINP==000010,,		; input interrupt
IODTER==100000			; Time out
IOBKTL==040000			; Mark seen
IODEND==020000			; End seen
ECHARR==010000,,		; echo controls with uparrow
FCS==   000020,,		; full character set
TBXPND==000010,,		; software tabs
FULTWX==000004,,		; no echo
XON==   000002,,		; paper tape mode
INTBTS==INTPTO\INTCLK\INTINP\INTIMS

; Macros

DEFINE FATAL TEXT
 JRST [	OUTSTR [ASCIZ\!TEXT
\]
	EXIT 1,
	JRST .-1]
TERMIN
;CORBEG INBUFH OUTBFH GOTINT TTYLIN PTIBUF COREND LSNBLK HOST SMRBLK RMRBLK INPBLK ECHOFF TYSBLK IMPSET LINCON LINCOF GAGOFF NTYSTS TERMID TERSTR

SUBTTL Data area

CORBEG==.			; first loc zeroed at init time

INBUFH:	BLOCK 3			; input buffer header
OUTBFH:	BLOCK 3			; output buffer header

GOTINT:	BLOCK 1			; -1 → got an interrupt
FLSCHP:	BLOCK 1			; -1 → ignore following character
TTYLIN:	BLOCK 1			; remember PTY line number here
PTIBUF:	BLOCK 30.		; PTY input buffer

COREND==.-1

LSNBLK:	1			; listen for connection
	0			; status word
	1			; socket number
HOST:	0			; host number returned here

SMRBLK:	2			; send Mark
	0			; status word
	6			; Timing Mark Reply

RMRBLK:	3			; read last Mark
	0			; status word
	0			; Mark type returned here

INPBLK:	4			; skip if input available
	0			; status word

ECHOFF:	001400,,(FULTWX)	; echo off

TYSBLK==.			; TTYSET command block
IMPSET:	034400,,		; IMP TTY
LINCON:	001400,,(ECHARR\FCS\TBXPND) ; default line chars
LINCOF:	002400,,(XON\FULTWX)
GAGOFF:	024400,,		; gag off
NTYSTS==.-TYSBLK

TERMID:	'TERMID			; terminal ID for FINGER
TERSTR:	BLOCK 10.
;CHTSER

SUBTTL Start of program

CHTSER:	CAI
	RESET			; flush all I/O
	PTYGET A		; snarf a PTY
	 FATAL Unable to get any PTY
	HRRZM A,TTYLIN
	INIT
	 SIXBIT/PUP/
	 OUTBFH,,INBUFH
	 JRST 4,.-1
	MOVEI 8.		; change byte size in buffer header
	DPB [300600,,INBUFH+1]
	DPB [300600,,OUTBFH+1]
	INBUF
	OUTPUT			; for some reason OUTBUF loses
	SETSTS			; kill IOIMPM bit
	MTAPE LSNBLK		; accept the connection
	 FATAL Listen failed
	MOVE ['CHTSER]
	SETNAM
	MOVS TTYLIN		; set up TTYSET command words
	IRPS FOO,,ECHOFF IMPSET LINCON LINCOF GAGOFF
	 IORM FOO
	TERMIN
	HRROI ECHOFF
	TTYSET
	MOVE A,TTYLIN		; get TTY line number back
	MOVEI B,[ASCIZ/Hello
/]
	PTWRS7 A
	MOVE [-NTYSTS,,TYSBLK]	; set up initial TTY status
	TTYSET
	LOCK
	MOVEI [	SETOM GOTINT
		DISMIS]		; set up interrupt server
	MOVEM JOBAPR
	CLKINT 30.*60.		; set up keep alive time
	MOVSI (INTBTS)
	INTENB			; enable interrupts
;FOO1 FOO2 FOO3 FOO4

	MOVEI TERMID
	MOVEM JOBVER
	MOVE A,[440700,,TERSTR]
	SKIPA B,[440700,,[ASCIZ/Ethernet host /]]
	 IDPB A
	ILDB B
	JUMPN .-2
	LDB B,[101000,,HOST]	; get network number
	IDIVI B,100		; split into separate parts
	IDIVI C,10
	JUMPE B,[JUMPE C,FOO2
		 JRST FOO1]
	ADDI B,"0
	IDPB B,A
FOO1:	ADDI C,"0
	IDPB C,A
FOO2:	ADDI D,"0
	IDPB D,A
	MOVEI "#		; network/host delimiter
	IDPB A
	LDB B,[001000,,HOST]	; get host number
	IDIVI B,100		; split into separate parts
	IDIVI C,10
	JUMPE B,[JUMPE C,FOO4
		 JRST FOO3]
	ADDI B,"0
	IDPB B,A
FOO3:	ADDI C,"0
	IDPB C,A
FOO4:	ADDI D,"0
	IDPB D,A
	SETZ			; tie off line
	IDPB A
	JRST LOOP0
;LOOP LOOP0 LOOP1 PUPLP0 PUPLP1

SUBTTL Main program

LOOP:	SKIPN GOTINT		; got an interrupt?
	 IMSTW [INTBTS]		; no, wait for an interrupt to happen
LOOP0:	INTMSK [0]		; mask off all interrupts
	SETZM GOTINT		; flag no interrupts here
LOOP1:
PUPLP0:	SOSLE INBUFH+2		; any data in buffer?
	 JRST PUPICH
	HRRZ A,INBUFH
	HRRZ A,(A)
	SKIPGE (A)		; anything in further buffers?
	 JRST PUPLP1
	MTAPE INPBLK		; no, anything in system?
	 JRST PTILP0
PUPLP1:	IN			; get the buffer
	 JRST PUPICH
	GETSTS A
	TRZE A,IODEND\IODTER	; End seen?
	 JRST CLOSED
	TRZN A,IOBKTL		; Mark seen?
	 JRST 4,.-1
	SETSTS (A)		; clear status
	MTAPE RMRBLK		; read the mark
	 JRST CLOSED
	MOVE RMRBLK+2		; get Mark type
;; Until implemented
;;	CAIN 1			; Data Mark?
;;	 AOS NTOINP
	CAIN 5			; Timing Mark?
	 JRST [	MTAPE SMRBLK	; yes, send Timing Mark Reply
		 JRST CLOSED
		JRST PUPLP0]
	CAIL 2			; between Line Width
	 CAILE 4		; and Terminal Type?
	  JRST PUPLP0		; no, ignore
	SETOM FLSCHP		; yes, ignore one byte
	JRST PUPLP0
;PUPICH PUPIC1 PTILP0 PTILUP PUPSND CLOSED

PUPICH:	IBP INBUFH+1		; point byte pointer at proper word
	MOVEI A,3		; padding bytes in this word?
	AND A,@INBUFH+1		; get count of padding bytes
	JUMPE A,PUPIC1		; no padding, charge on
	MOVE @INBUFH+1		; right justify the data in the word
	ANDCM A			; turn off the padding bytes
	XCT (A)[LSH -24.	; one significant byte
		LSH -16.	; two significant bytes
		LSH -8.]-1	; three significant bytes
	MOVEM @INBUFH+1
	XCT (A)[MOVEI 041000
		MOVEI 141000
		MOVEI 241000]-1
	HRLM INBUFH+1		; update the buffer header byte pointer
	SUBI A,4		; compute negative number of padding bytes
	ADDM A,INBUFH+2		; discount padding bytes from buffer header
PUPIC1:	MOVE C,TTYLIN
	LDB D,INBUFH+1
	AOSE FLSCHP		; send character to PTY unless need to ignore
	 PTWR1W C
	JRST PUPLP0

PTILP0:	STATZ IODEND		; connection closed?
	 JRST CLOSED		; yes, go away
	MOVE A,TTYLIN		; read buffer from PTY
	MOVE B,[441140,,PTIBUF]
	PTRDS A
	ILDB B
	JUMPE LOOP
PTILUP:	ANDI 377
	SOSG OUTBFH+2
	 OUT
	  CAIA
	   JRST CLOSED
	IDPB OUTBFH+1
	ILDB B
	JUMPN PTILUP
PUPSND:	OUTPUT			; send the buffer
	JRST LOOP1		; Go look for more output, after checking
				; first checking for pending input.

CLOSED:	OUTSTR [ASCIZ/Connection closed/]
	EXIT

END CHTSER